SGI Freeware 1999 August/SGI Freeware 1999 August.iso/dist/fw_gnats.idb/usr/freeware/lib/gnats/contrib/tkgnats/tkprfolder.t.z/tkprfolder.t

Text File | 1999-04-16 | 4.7 KB | 200 lines

#
# $Id: tkprfolder.t,v 1.2 1993/11/16 22:19:37 jason Exp $
#
# TkGnats PR folders module
#

#
# -- globals
#
set Tkprfolder(dir) "[glob ~]/TkGnats/folders"
set Tkprfolder(foldernameregexp) {^[a-zA-z0-9]+[a-zA-Z0-9_.]*}

proc tkprfolder_checkdirs {args} {
    foreach d $args {
    set d [glob $d]
    if {![file isdirectory $d]} {
        if {[catch {exec mkdir $d} x]} {
        Msg "Error creating directory $d" "'$x'"
        return -1
        }
    }
    }
    return 0
}

proc tkprfolder_button_cmd {cmd top lbox} {
    global Tkprfolder
    if {"$cmd" == "Exit"} {
    destroy $top
    return
    }
    if {"$cmd" == "New"} {
    tkprfolder_new $top
    return
    }
    # get the selected item (if there is one)
    set x  [$lbox curselection]
    if {"$x" == ""} {
    Msg "No selection availble in the folder list box"
    return
    }
    set idx [lindex $x 0]
    set folder [$lbox get $idx]
    if {"$cmd" == "Query"} {
    set prlist {}
    foreach p [split [exec cat $folder] "\t\n "] {
        if {"$p" != ""} {
        lappend prlist $p
        }
    }
    query_cmd $prlist
    return
    }
    if {"$cmd" == "Rename"} {
    set newname \
        [exec entryDialog "Enter new name for \n[exec basename $folder]"]
    if {"$newname" == ""} {
        return
    }
    if {![regexp $Tkprfolder(foldernameregexp) $newname]} {
        Msg "Folder names must be composed only of" \
        "letters numbers underscores and periods"
        return
    }
    exec mv $folder $Tkprfolder(dir)/$newname
    tkprfolder_resync $top
    return
    }
    if {"$cmd" == "Delete"} {
    if {"$folder" == "$Tkprfolder(dir)/Backup--Folder"} {
        Msg "You are not allowed to delete $folder"
        return
    }
    exec mv $folder $Tkprfolder(dir)/Backup--Folder
    tkprfolder_resync $top
    return
    }
    if {"$cmd" == "Edit"} {
    if {"$folder" == "$Tkprfolder(dir)/Backup--Folder"} {
        Msg "You are not allowed to edit $folder"
        return
    }
    exec cp $folder $Tkprfolder(dir)/Backup--Folder
    tkprfolder_edit $folder $top
    return
    }
    Msg "tkprfolder_button_cmd:" "do not understand the $cmd operation"
}

proc tkprfolder_edit_Cancel {top txt fname flisttop} {
    destroy $top
}
proc tkprfolder_edit_Write {top txt fname flisttop} {
    exec cat << [$txt get 1.0 end] > $fname
    destroy $top
    tkprfolder_resync $flisttop
}

proc tkprfolder_resync {flisttop} {
    if {[winfo exists $flisttop]} {
    tkprfolder_dialog $flisttop
    }
}

proc tkprfolder_edit {fname flisttop} {
    set f .tkprfolder_edit_file
    if {[winfo exists $f]} {
    Msg "You are can only edit one folder at a time"
    return
    }
    toplevel $f
    frame $f.buttons
    foreach x {Cancel Write} {
    button $f.buttons._$x -text $x \
        -command "tkprfolder_edit_$x $f $f.text $fname $flisttop"
    pack append $f.buttons $f.buttons._$x {left padx 8}
    }
    scrollbar $f.sb -command "$f.text yview" -relief sunken
    text $f.text \
    -font fixed \
    -yscrollcommand "$f.sb set" \
    -height 15 -width 40 -relief sunken -padx 4 -insertwidth 1 \
    -insertofftime 400 -borderwidth 2
    bind $f.text <Enter> "+focus $f.text"
    bind $f.text <Control-g> {
    set s [prid_from_selection]
    if {"$s" != ""} {
        %W insert 1.0 "$s\n"
    }
    }

    pack append $f \
    $f.buttons {bottom} \
    $f.sb {left filly} \
    $f.text {right expand fill}
    if {[file exists $fname]} {
    $f.text insert 1.0 [exec cat $fname]
    }
    wm title $f "Tkprfolder: [exec basename $fname]"
}


proc tkprfolder_new {flisttop} {
    global Tkprfolder
    set fname [exec entryDialog "Enter name of folder file"]
    if {"$fname" == ""} {
    return
    }
    if {![regexp $Tkprfolder(foldernameregexp) $fname]} {
    Msg "Folder names must be composed only of" \
        "letters numbers underscores and periods"
    return
    }
    tkprfolder_edit $Tkprfolder(dir)/$fname $flisttop
}

proc tkprfolder_cmd {cmd w y} {
    set idx [$w nearest $y]
    set fname [$w get $idx]
    query_cmd [split [exec cat $fname] " \n\t"]
}

proc tkprfolder_dialog {w} {
    global Tkprfolder
    if {[tkprfolder_checkdirs ~/TkGnats $Tkprfolder(dir)] < 0} {
    return
    }
    # first get the list of folders for this person
    set folder_list {}
    catch {[set folder_list [glob $Tkprfolder(dir)/*]]}

    if {[winfo exists $w]} {
    $w.list delete 0 end
    } else {
    toplevel $w

    message $w.msg -anchor w -text "Folders" -aspect 10000
    scrollbar $w.sb \
        -borderwidth 2 -relief sunken \
        -command "$w.list yview"
    listbox $w.list -yscroll "$w.sb set" \
        -setgrid 1 \
        -relief sunken -borderwidth 2 \
        -geometry 40x8
    tk_listboxSingleSelect $w.list
    frame $w.buttons
    foreach x {Edit Query Delete Rename New Exit} {
        button $w.buttons._$x -text $x \
        -command "tkprfolder_button_cmd $x $w $w.list"
        pack append $w.buttons $w.buttons._$x {left padx 8}
    }
    pack append $w \
        $w.buttons {bottom} \
        $w.msg {top fillx} \
        $w.sb {left filly} \
        $w.list {right expand fillx}
    }
    eval $w.list insert end $folder_list
}